home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / ANSIDOOR.PAS < prev    next >
Pascal/Delphi Source File  |  1997-07-12  |  12KB  |  262 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....}
  13.  
  14. {   Adjust your compiler directives as you see fit  }
  15. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  16. Program ANSIDOOR;
  17.      {*******--See the notes below on the GENOVR unit, this is important!}
  18. USES {GENOVR,} CRT, TDK_VARS, DOORKIT1, DOORKIT2, DOORKIT3;
  19.                    {^^^^^^^^^^^^^^^^^^-The bare minimum of unit declarations.
  20.           Make note of the order of the unit declarations. Any other unit you
  21.           declare in your main program,  must be inserted before these units.
  22.           Each of those units  must also show these three  units in the exact
  23.           same fashion as you see here in order to retain full error trapping
  24.           and automatic door shutdown.}
  25.  
  26. {.$O DOORKIT1}
  27. {.$O DOORKIT2}
  28. {.$O DOORKIT3}
  29. {.$O MAXSPOOL}
  30.  
  31. {To show you the advantage of using overlays in your programs, un-comment the
  32.  GENOVR unit in the "USES" clause and remove the period at the beginning of
  33.  all the $O unit declarations in the above. After you run the program, you'll
  34.  see that the remaining free conventional memory has increased. The reason
  35.  for this is because the $O declared units are no longer loaded into memory
  36.  full time. The only time any of their procedures are loaded are when your
  37.  program calls them. Using overlays allows you to write programs much larger
  38.  than the 640K conventional memory limit without using excessive amounts of
  39.  memory. Be careful what units you overlay because overlayed units slow down
  40.  a little bit because of the time required to load the procedures.}
  41.  
  42. VAR
  43.   Str   : STRING;
  44.   Ch    : CHAR;
  45.   X     : BYTE;
  46.   Y     : BYTE;
  47.   MinX  : BYTE;
  48.   MinY  : BYTE;
  49.   MaxX  : BYTE;
  50.   MaxY  : BYTE;
  51.   Loop  : BYTE;
  52.   Quit  : BOOLEAN;
  53.  
  54. BEGIN
  55.   {--------------------------------------------------------------------------}
  56.   { This is all that is needed to initialize your door program...You may add }
  57.   { more variable/constant modifications at your own discretion...           }
  58.   {--------------------------------------------------------------------------}
  59.   ProgramName := 'ANSIDOOR.EXE Version -9.02E+16';
  60.   ProgramDesc := 'Example ANSI Door Program For "The DoorKit"';
  61.   {--------------------------------------------------------------------------}
  62.   { Use this if you want to incorporate activity logging.                    }
  63.   {--------------------------------------------------------------------------}
  64.   GETDIR(0,LogPath);
  65.   UseLog  := TRUE;
  66.   LogPath := FixPath(LogPath);
  67.   LogFile := 'ACTIVITY.LOG';
  68.   {--------------------------------------------------------------------------}
  69.   { After you have made all of your variable/constant modifications, you can }
  70.   { initialize or "Start Up" your door program...                            }
  71.   {--------------------------------------------------------------------------}
  72.   InitDoorKit;
  73.   {--------------------------------------------------------------------------}
  74.   { Since this example door has no MAX or RIP routines in it we want to make }
  75.   { MAXterm or RIPterm switch back to text mode (ie: ANSI Emulation Only)... }
  76.   {--------------------------------------------------------------------------}
  77.   IF Graphics IN [MAX,RIP] THEN BEGIN
  78.     RipToText;
  79.     Graphics := ANSI;
  80.   END;
  81.   {--------------------------------------------------------------------------}
  82.   REPEAT
  83.     sWriteln(''); InfoText('Please Select A Function:'); sWriteln('');
  84.     LineBar(1,0,33);
  85.     CPrompt('A',' Display An ANSI Screen File');  sWriteln('');
  86.     CPrompt('B',' Display A Text File');          sWriteln('');
  87.     CPrompt('C',' Test An Entry Field');          sWriteln('');
  88.     CPrompt('D',' Display A Window');             sWriteln('');
  89.     CPrompt('E',' Run An Entry Form Script');     sWriteln('');
  90.     CPrompt('F',' Simulate Drop Down Menus');     sWriteln('');
  91.     CPrompt('G',' Test Cursor Control Keys');     sWriteln('');
  92.     CPrompt('Q',' Quit/Exit The Demo Program');   sWriteln('');
  93.     LineBar(1,0,33);
  94.     FancyPrompt;
  95.     Ch := UPCASE(sReadKey); sWriteln('');
  96.     CASE Ch OF
  97.       'A' : BEGIN
  98.               Log('Caller Diplaying ANSI Screen File');
  99.               ShowScreen('BBS-UTIL.ANS');
  100.               AnyKey;
  101.             END;
  102.       'B' : BEGIN
  103.               Log('Caller Reading Text File');
  104.               ShowTextFile('DOORKIT.DOC');
  105.             END;
  106.       'C' : BEGIN
  107.               Log('Caller Testing An Entry Field');
  108.               sWriteln('');
  109.               OutTxt(11,0,'Enter Some Text: ');
  110.               IF Graphics = TTY THEN Str := NormalInput(50,'Test String')
  111.                                 ELSE Str := NormalPrompt(50,'Test String');
  112.               Str := CvtVars(Str); {Check For Variables}
  113.               sWriteln('');
  114.               Set_Color(10,0);
  115.               CvtColors('You Entered: {14}'+Str,TRUE); {Converts Colors}
  116.               sWriteln('');
  117.               AnyKey;
  118.             END;
  119.       'D' : IF Graphics <> TTY Then BEGIN
  120.               Log('Caller Displaying A Test Window');
  121.               sClrScr;
  122.               OutTxtL(10,0,'Since this procedure uses specific X / Y coordinates,  the caller must have');
  123.               OutTxtL(10,0,'ANSI graphics capabilities. TTY/ASCII callers would see nothing but garbage');
  124.               OutTxtL(10,0,'on their screen. This is the reason for the "IF Graphics <> TTY THEN BEGIN"');
  125.               DrawWin(5,5,74,19, 'This Is An Example Window');
  126.               OutTxtXY(7,7,11,1, '    Enter Your Name:'); DummyField(27,7,40,'');
  127.               OutTxtXY(7,8,11,1, ' Enter Your Address:'); DummyField(27,8,40,'');
  128.               OutTxtXY(7,9,11,1, '    Enter Your City:'); DummyField(27,9,20,'');
  129.               OutTxtXY(7,10,11,1,'   Enter Your State:'); DummyField(27,10,20,'');
  130.               OutTxtXY(7,11,11,1,'Enter Your Zip Code:'); DummyField(27,11,12,'');
  131.               OutTxtXY(7,12,11,1,' Voice Phone Number:'); DummyField(27,12,12,'');
  132.               OutTxtXY(7,13,11,1,'  Data Phone Number:'); DummyField(27,13,12,'');
  133.               SysButton(56,15,'S','ave');
  134.               SysButton(65,15,'Q','uit');
  135.               Str := SysField(27,7,2,40,'');
  136.               Str := SysField(27,8,2,40,'');
  137.               Str := SysField(27,9,2,20,'');
  138.               Str := SysField(27,10,2,20,'');
  139.               Str := SysField(27,11,1,12,'');
  140.               Str := SysField(27,12,1,12,'');
  141.               Str := SysField(27,13,1,12,'');
  142.               OutTxtXY(7,17,10,1,'Do you see how this mess of mine is actually working?');
  143.               sGotoXY(5,23); AnyKey;
  144.             END ELSE BEGIN
  145.               sWriteln('');
  146.               OutTxtL(12,0,'Sorry, ANSI Graphics Required For This....');
  147.               sWriteln('');
  148.               AnyKey;
  149.             END;
  150.       'E' : BEGIN
  151.               Log('Caller Testing An Entry Form');
  152.               RunEntryForm('QUEST1.FRM');
  153.             END;
  154.       'F' : BEGIN
  155.               Log('Caller Testing Pseudo Drop Down Menus');
  156.               sClrScr;
  157.               sGotoXY(1,1); OutTxt(0,7,PadRight(' ',' ',79)); sGotoXY(1,1);
  158.               MenuBarItem(3,1,'M','ain Menu');
  159.               MenuBarItem(23,1,'F','ile Menu');
  160.               MenuBarItem(43,1,'E','-Mail Menu');
  161.               MenuBarItem(63,1,'S','ysOp Menu');
  162.               DrawMenu(2,2,20,10);
  163.               MenuItem(3,3,'F','irst Function');
  164.               MenuItem(3,4,'S','econd Function');
  165.               MenuItem(3,5,'T','hird Function');
  166.               MenuLine(2,6,19);
  167.               MenuItem(3,7,'A','nother Function');
  168.               MenuItem(3,8,'S','omthing Else');
  169.               MenuItem(3,9,'Q','uit This Menu');
  170.               OutTxtXY(2,13,10,0,'Since this door kit provides full support for local and remote cursor control');
  171.               OutTxtXY(2,14,10,0,'keys, you could create doors that have full drop down menus and windows that');
  172.               OutTxtXY(2,15,10,0,'can pop up whenever and wherever you need them. With this, you can provide');
  173.               OutTxtXY(2,16,10,0,'your users with a more "Natural" look and feel which will make it easier for');
  174.               OutTxtXY(2,17,10,0,'them to understand and use your doors. Using the cursor control keys to move');
  175.               OutTxtXY(2,18,10,0,'the cursor and menus around just seems to come naturally most people.');
  176.               sGotoXY(2,23); AnyKey;
  177.             END;
  178.       'G' : BEGIN
  179.               Log('Caller Testing Local/Remote Cursor Keys');
  180.               BackSpaceChar := ' ';
  181.               Set_Color(7,0); sClrScr;
  182.               OutTxtL(15,1,PadRight(' This is a test of the local and remote cursor control keys....',' ',79));
  183.               OutTxtL(11,1,PadRight(' Press ESC twice to exit. Use ^N and ^P to increment and decrement colors.',' ',79));
  184.               Set_Color(7,0); sClrEol;
  185.               Quit := FALSE;
  186.               MinX := 1; MaxX := 79; X := MinX;
  187.               MinY := 3; MaxY := LengthScr; Y := MinY;
  188.               REPEAT
  189.                 sGotoXY(X,Y);
  190.                 Ch := sReadKey;
  191.                 CASE Ch OF
  192.                   #0  : Str := s_ReadKey;
  193.                   #22 : BEGIN
  194.                           sWaitInput(250);
  195.                           IF sKeyPressed THEN Str := Ch + sReadKey ELSE Str := Ch;
  196.                         END;
  197.                   #27 : BEGIN
  198.                           Str := Ch;
  199.                           Ch  := sReadKey;
  200.                           IF Ch = #27 THEN BEGIN
  201.                             Quit := TRUE;
  202.                             STR  := '';
  203.                           END ELSE Str := Str + Ch + sReadKey;
  204.                         END;
  205.                   ^N  : BEGIN
  206.                           IF TextAttr AND $0f < 15 THEN INC(TextAttr) ELSE TextAttr := TextAttr AND $F0;
  207.                           IF NOT Local THEN SendStr(AnsiColor);
  208.                         END;
  209.                   ^P  : BEGIN
  210.                           IF TextAttr AND $0f > 0  THEN DEC(TextAttr) ELSE TextAttr := TextAttr AND $F0 OR $F;
  211.                           IF NOT Local THEN SendStr(AnsiColor);
  212.                         END;
  213.                   #8  : IF X > MinX THEN BEGIN
  214.                           DEC(X);
  215.                           sWrite(#8+BackSpaceChar+#8);
  216.                         END;
  217.                   #1..#31:; {Scrap keys, just ignore them....}
  218.                   ELSE BEGIN
  219.                     IF X < MaxX THEN BEGIN
  220.                       sWriteC(Ch);
  221.                       INC(X);
  222.                     END ELSE IF X = MaxX THEN sWriteC(Ch);
  223.                   END;
  224.                 END;
  225.                 IF Str <> '' THEN FOR Loop := TTY TO AVATAR DO BEGIN
  226.                   IF Str = CursorMove.Up[Loop] THEN BEGIN
  227.                     DEC(Y);
  228.                     Str := '';
  229.                   END;
  230.                   IF Str = CursorMove.Down[Loop] THEN BEGIN
  231.                     INC(Y);
  232.                     Str := '';
  233.                   END;
  234.                   IF Str = CursorMove.Left[Loop] THEN BEGIN
  235.                     DEC(X);
  236.                     Str := '';
  237.                   END;
  238.                   IF Str = CursorMove.Right[Loop] THEN BEGIN
  239.                     INC(X);
  240.                     Str := '';
  241.                   END;
  242.                   IF Str = CursorMove.Home[Loop] THEN BEGIN
  243.                     X   := MinX;
  244.                     Str := '';
  245.                   END;
  246.                   IF Str = CursorMove.EndKey[Loop] THEN BEGIN
  247.                     X   := MaxX;
  248.                     Str := '';
  249.                   END;
  250.                 END;
  251.                 IF X > MaxX THEN X := MaxX;
  252.                 IF Y > MaxY THEN Y := MaxY;
  253.                 IF X < MinX THEN X := MinX;
  254.                 IF Y < MinY THEN Y := MinY;
  255.               UNTIL Quit;
  256.             END;
  257.     END;
  258.     IF Ch <> 'Q' THEN ShowProgramAd;
  259.   UNTIL Ch = 'Q';
  260.   Log('Caller Exited '+ProgramName);
  261. END.
  262.